home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / turbtool.arc / TOOLU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-04-01  |  11.5 KB  |  621 lines
  1. CONST
  2.   IOERROR=0;
  3.   STDIN=1;
  4.   STDOUT=2;
  5.   STDERR=3;
  6. (*IO RELEATED STUFF*)
  7.   MAXOPEN=7;
  8.   IOREAD=0;
  9.   IOWRITE=1;
  10.   MAXCMD=20;
  11.   ENDFILE=255;
  12.   BLANK=32;
  13.   ENDSTR=0;
  14.   MAXSTR=100;
  15.   BACKSPACE=8;
  16.   TAB=9;
  17.   NEWLINE=10;
  18.   EXCLAM=33;
  19.   DQUOTE=34;
  20.   SHARP=35;
  21.   DOLLAR=36;
  22.   PERCENT=37;
  23.   AMPER=38;
  24.   SQUOTE=39;
  25.   ACUTE=SQUOTE;
  26.   LPAREN=40;
  27.   RPAREN=41;
  28.   STAR=42;
  29.   PLUS=43;
  30.   COMMA=44;
  31.   MINUS=45;
  32.   DASH=MINUS;
  33.   PERIOD=46;
  34.   SLASH=47;
  35.   COLON=58;
  36.   SEMICOL=59;
  37.   LESS=60;
  38.   EQUALS=61;
  39.   GREATER=62;
  40.   QUESTION=63;
  41.   ATSIGN=64;
  42.   ESCAPE=ATSIGN;
  43.   LBRACK=91;
  44.   BACKSLASH=92;
  45.   RBRACK=93;
  46.   CARET=94;
  47.   GRAVE=96;
  48.   UNDERLINE=95;
  49.   TILDE=126;
  50.   LBRACE=123;
  51.   BAR=124;
  52.   RBRACE=125;
  53.   
  54. TYPE
  55.    CHARACTER=0..255;
  56.    XSTRING=ARRAY[1..MAXSTR]OF CHARACTER;
  57.   STRING80=string[80];
  58.   FILEDESC=IOERROR..MAXOPEN;
  59.   FILTYP=(CLOSED,STDIO,FIL1,FIL2,FIL3,FIL4);
  60.  
  61. VAR
  62.    KBDN,KBDNEXT:INTEGER;
  63.    KBDLINE:XSTRING;
  64.    CMDARGS:0..MAXCMD;
  65.    CMDIDX:ARRAY[1..MAXCMD] OF 1..MAXSTR;
  66.    CMDLIN:XSTRING;
  67.    CMDLINE:STRING80;
  68.    CMDFIL:ARRAY[STDIN..MAXOPEN]OF FILTYP;
  69.    CMDOPEN:ARRAY[FILTYP]OF BOOLEAN;
  70.    FILE1,FILE2,FILE3,FILE4:TEXT;
  71.    
  72.  
  73.  
  74. FUNCTION GETKBD(VAR C:CHARACTER):CHARACTER;FORWARD;
  75. FUNCTION FGETCF(VAR FIL:TEXT):CHARACTER;FORWARD;
  76. FUNCTION GETCF(VAR C:CHARACTER;FD:FILEDESC):CHARACTER;FORWARD;
  77. FUNCTION GETC(VAR C:CHARACTER):CHARACTER;FORWARD;
  78. PROCEDURE FPUTCF(C:CHARACTER;VAR FIL:TEXT);FORWARD;
  79. PROCEDURE PUTCF(C:CHARACTER;FD:FILEDESC);FORWARD;
  80. PROCEDURE PUTC(C:CHARACTER);FORWARD;
  81. PROCEDURE PUTDEC(N,W:INTEGER);FORWARD;
  82. FUNCTION ITOC(N:INTEGER;VAR S:XSTRING;I:INTEGER):INTEGER;FORWARD;
  83. FUNCTION GETARG(N:INTEGER;VAR S:XSTRING;
  84.   MAXSIZE:INTEGER):BOOLEAN;FORWARD;
  85.   PROCEDURE SCOPY(VAR SRC:XSTRING;I:INTEGER;VAR DEST:XSTRING;J:INTEGER);FORWARD;
  86. PROCEDURE ENDCMD;FORWARD;
  87. PROCEDURE XCLOSE(FD:FILEDESC);FORWARD;
  88. FUNCTION MUSTCREATE(VAR NAME:XSTRING;MODE:INTEGER):
  89. FILEDESC;FORWARD;
  90. FUNCTION CREATE(VAR NAME:XSTRING;MODE:INTEGER):FILEDESC;FORWARD;
  91. FUNCTION XLENGTH(VAR S:XSTRING):INTEGER;FORWARD;
  92. PROCEDURE STRNAME(VAR STR:STRING80;VAR XSTR:XSTRING);FORWARD;
  93. PROCEDURE ERROR(STR:STRING80);FORWARD;
  94. FUNCTION MAX(X,Y:INTEGER):INTEGER;FORWARD;
  95. PROCEDURE REMOVE(NAME:XSTRING);FORWARD;
  96. FUNCTION GETLINE(VAR STR:XSTRING;FD:FILEDESC;
  97.   SIZE:INTEGER):BOOLEAN;FORWARD;
  98.   FUNCTION OPEN(VAR NAME:XSTRING;MODE:INTEGER):
  99. FILEDESC;FORWARD;
  100. FUNCTION FDALLOC:FILEDESC;FORWARD;
  101. FUNCTION FTALLOC:FILTYP;FORWARD;
  102. FUNCTION NARGS:INTEGER;FORWARD;
  103. FUNCTION ADDSTR(C:CHARACTER;VAR OUTSET:XSTRING;
  104.   VAR J:INTEGER;MAXSET:INTEGER):BOOLEAN;FORWARD;
  105. PROCEDURE PUTSTR(STR:XSTRING;FD:FILEDESC);FORWARD;
  106. FUNCTION MUSTOPEN(VAR NAME:XSTRING;MODE:INTEGER):FILEDESC;FORWARD;
  107. FUNCTION MIN(X,Y:INTEGER):INTEGER;FORWARD;
  108. FUNCTION ISUPPER(C:CHARACTER):BOOLEAN;FORWARD;
  109. FUNCTION EQUAL(VAR STR1,STR2:XSTRING):BOOLEAN;FORWARD;
  110. FUNCTION INDEX(VAR S:XSTRING;C:CHARACTER):INTEGER;FORWARD;
  111. FUNCTION ISALPHANUM(C:CHARACTER):BOOLEAN;FORWARD;
  112. FUNCTION ESC(VAR S:XSTRING;VAR I:INTEGER):
  113.      CHARACTER;FORWARD;
  114. PROCEDURE FCOPY(FIN,FOUT:FILEDESC);FORWARD;
  115. FUNCTION CTOI(VAR S:XSTRING;VAR I:INTEGER):INTEGER;FORWARD;
  116. FUNCTION ISDIGIT(C:CHARACTER):BOOLEAN;FORWARD;
  117. FUNCTION ISLOWER(C:CHARACTER):BOOLEAN;FORWARD;
  118. FUNCTION ISLETTER(C:CHARACTER):BOOLEAN;FORWARD;
  119.  
  120. FUNCTION ISDIGIT;
  121. BEGIN
  122.   ISDIGIT:=C IN [ORD('0')..ORD('9')]
  123. END;
  124.  
  125. FUNCTION ISLOWER;
  126. BEGIN
  127.   ISLOWER:=C IN [97..122]
  128. END;
  129.  
  130. FUNCTION ISLETTER;
  131. BEGIN
  132.   ISLETTER:=C IN [65..90]+[97..122]
  133. END;
  134.  
  135. FUNCTION CTOI;
  136. VAR N,SIGN:INTEGER;
  137. BEGIN
  138.   WHILE (S[I]=BLANK) OR (S[I]=TAB)DO
  139.     I:=I+1;
  140.   IF(S[I]=MINUS) THEN
  141.     SIGN:=-1
  142.   ELSE
  143.     SIGN:=1;
  144.   IF(S[I]=PLUS)OR(S[I]=MINUS)THEN
  145.     I:=I+1;
  146.   N:=0;
  147.   WHILE(ISDIGIT(S[I])) DO BEGIN
  148.     N:=10*N+S[I]-ORD('0');
  149.     I:=I+1
  150.   END;
  151.   CTOI:=SIGN*N
  152. END;
  153.  
  154. PROCEDURE FCOPY;
  155. VAR
  156.   C:CHARACTER;
  157. BEGIN
  158.   WHILE(GETCF(C,FIN)<>ENDFILE) DO
  159.     PUTCF(C,FOUT)
  160. END;
  161.  
  162.  
  163.    
  164.  
  165. FUNCTION INDEX;
  166. VAR I:INTEGER;
  167. BEGIN
  168.   I:=1;
  169.   WHILE(S[I]<>C) AND (S[I]<>ENDSTR)DO
  170.     I:=I+1;
  171.   IF (S[I]=ENDSTR) THEN
  172.     INDEX:=0
  173.   ELSE
  174.     INDEX:=I
  175. END;
  176.  
  177. FUNCTION ESC;
  178. BEGIN
  179.   IF(S[I]<>ATSIGN) THEN
  180.     ESC:=S[I]
  181.   ELSE IF(S[I+1]=ENDSTR) THEN (*@ NOT SPECIAL AT END*)
  182.     ESC:=ATSIGN
  183.   ELSE BEGIN
  184.     I:=I+1;
  185.     IF(S[I]=ORD('N'))THEN ESC:=NEWLINE
  186.     ELSE IF (S[I]=ORD('T')) THEN
  187.       ESC:=TAB
  188.     ELSE
  189.       ESC:=S[I]
  190.   END
  191. END;
  192.  
  193. FUNCTION ISALPHANUM;
  194. BEGIN
  195.   ISALPHANUM:=C IN
  196.     [ORD('A')..ORD('Z'),ORD('0')..ORD('9'),
  197.     97..122]
  198. END;
  199.  
  200. FUNCTION MAX;
  201. BEGIN
  202.   IF(X>Y)THEN
  203.     MAX:=X
  204.   ELSE
  205.     MAX:=Y
  206. END;
  207.  
  208.  
  209. FUNCTION MIN;
  210. BEGIN
  211.   IF X<Y THEN
  212.     MIN:=X
  213.   ELSE
  214.     MIN:=Y
  215. END;
  216.  
  217.  
  218. FUNCTION ISUPPER;
  219.   BEGIN
  220.     ISUPPER:=C IN [ORD('A')..ORD('Z')]
  221.   END;
  222.  
  223.  
  224. FUNCTION XLENGTH;
  225. VAR
  226.   N:INTEGER;
  227. BEGIN
  228.   N:=1;
  229.   WHILE(S[N]<>ENDSTR)DO
  230.     N:=N+1;
  231.   XLENGTH:=N-1
  232. END;
  233.  
  234. FUNCTION GETARG;
  235. BEGIN
  236.   IF((N<1)OR(CMDARGS<N))THEN
  237.     GETARG:=FALSE
  238.   ELSE BEGIN
  239.     SCOPY(CMDLIN,CMDIDX[N],S,1);
  240.     GETARG:=TRUE
  241.   END
  242. END;(*GETARG*)
  243.  
  244.  
  245.   PROCEDURE SCOPY;
  246.   BEGIN
  247.     WHILE(SRC[I]<>ENDSTR)DO BEGIN
  248.       DEST[J]:=SRC[I];
  249.       I:=I+1;
  250.       J:=J+1
  251.     END;
  252.     DEST[J]:=ENDSTR
  253.   END;
  254.   
  255.   
  256.   
  257. (*$I-*)
  258. FUNCTION CREATE;
  259. VAR
  260.   FD:FILEDESC;
  261.   SNM:STRING80;
  262. BEGIN
  263.   FD:=FDALLOC;
  264.   IF(FD<>IOERROR)THEN BEGIN
  265.   STRNAME(SNM,NAME);
  266.   CASE (CMDFIL[FD])OF
  267.   FIL1:
  268.     begin assign(FILE1,SNM);rewrite(FILE1) end;
  269.   FIL2:begin assign(FILE2,SNM);rewrite(FILE2) end;
  270.   FIL3:begin assign(FILE3,SNM);rewrite(FILE3) end;
  271.   FIL4:begin assign(FILE4,SNM);rewrite(FILE4) end
  272.   END;
  273.   IF(IORESULT<>0)THEN BEGIN
  274.     XCLOSE(FD);
  275.     FD:=IOERROR
  276.   END
  277. END;
  278. CREATE:=FD;
  279. END;
  280. (*$I+*)
  281.  
  282. PROCEDURE STRNAME;
  283. VAR I:INTEGER;
  284. BEGIN
  285.   STR:='.PAS';
  286.   I:=1;
  287.   WHILE(XSTR[I]<>ENDSTR)DO BEGIN
  288.     INSERT('X',STR,I);
  289.     STR[I]:=CHR(XSTR[I]);
  290.     I:=I+1
  291.   END
  292. END;
  293. PROCEDURE ERROR;
  294. BEGIN
  295.   WRITELN(STR);
  296.   BDOS(0,0)
  297. END;
  298.  
  299. FUNCTION MUSTCREATE;
  300. VAR
  301.   FD:FILEDESC;
  302. BEGIN
  303.   FD:=CREATE(NAME,MODE);
  304.   IF(FD=IOERROR)THEN BEGIN
  305.     PUTSTR(NAME,STDERR);
  306.     ERROR('  :CAN''T CREATE FILE')
  307.   END;
  308.   MUSTCREATE:=FD
  309. END;
  310.  
  311. FUNCTION NARGS;
  312. BEGIN
  313.   NARGS:=CMDARGS
  314. END;
  315.  
  316. PROCEDURE REMOVE;
  317. VAR
  318.   FD:FILEDESC;
  319. BEGIN
  320.   FD:=OPEN(NAME,IOREAD);
  321.   IF(FD=IOERROR)THEN
  322.   WRITELN('CAN''T REMOVE FILE')
  323.   ELSE BEGIN
  324.     CASE (CMDFIL[FD]) OF
  325.     FIL1:CLOSE(FILE1);
  326.     FIL2:CLOSE(FILE2);
  327.     FIL3:CLOSE(FILE3);
  328.     FIL4:CLOSE(FILE4);
  329.     END
  330.   END;
  331.   CMDFIL[FD]:=CLOSED
  332. END;
  333.  
  334. FUNCTION GETLINE;
  335. VAR I:INTEGER;
  336.     DONE:BOOLEAN;
  337.     CH:CHARACTER;
  338. BEGIN
  339.  I:=0;
  340.  REPEAT
  341.    DONE:=TRUE;
  342.    CH:=GETCF(CH,FD);
  343.    IF(CH=ENDFILE) THEN
  344.      I:=0
  345.    ELSE IF (CH=NEWLINE) THEN BEGIN
  346.      I:=I+1;
  347.      STR[I]:=NEWLINE
  348.    END
  349.    ELSE IF (SIZE-2<=I) THEN BEGIN
  350.      WRITELN('LINE TOO LONG');
  351.      I:=I+1;
  352.      STR[I]:=NEWLINE
  353.    END
  354.    ELSE BEGIN
  355.      DONE:=FALSE;
  356.      I:=I+1;
  357.      STR[I]:=CH
  358.    END
  359.  UNTIL(DONE);
  360.  STR[I+1]:=ENDSTR;
  361.  GETLINE:=(0<I)
  362. END;(*GETLINE*)
  363.  
  364. (*$I-*)
  365. FUNCTION OPEN;
  366. VAR FD:FILEDESC;
  367. SNM:STRING80;
  368. BEGIN
  369.   FD:=FDALLOC;
  370.   IF(FD<>IOERROR) THEN BEGIN
  371.     STRNAME(SNM,NAME);
  372.     CASE (CMDFIL[FD]) OF
  373.     FIL1:begin assign(FILE1,SNM);RESET(FILE1) end;
  374.     FIL2:begin assign(FILE2,SNM);RESET(FILE2) end;
  375.     FIL3:begin assign(FILE3,SNM);RESET(FILE3) end;
  376.     FIL4:begin assign(FILE4,SNM);RESET(FILE4) end
  377.     END;
  378.     IF(IORESULT<>0) THEN BEGIN
  379.       XCLOSE(FD);
  380.       FD:=IOERROR
  381.     END
  382.   END;
  383.   OPEN:=FD
  384. END;
  385. (*$I+*)
  386.  
  387. FUNCTION FTALLOC;
  388. VAR DONE:BOOLEAN;
  389.    FT:FILTYP;
  390. BEGIN
  391.   FT:=FIL1;
  392.   REPEAT
  393.     DONE:=(NOT CMDOPEN[FT] OR (FT=FIL4));
  394.     IF(NOT DONE) THEN
  395.       FT:=SUCC(FT)
  396.   UNTIL (DONE);
  397.   IF(CMDOPEN[FT]) THEN
  398.     FTALLOC:=CLOSED
  399.   ELSE
  400.     FTALLOC:=FT
  401. END;
  402.  
  403. FUNCTION FDALLOC;
  404. VAR DONE:BOOLEAN;
  405. FD:FILEDESC;
  406. BEGIN
  407.   FD:=STDIN;
  408.   DONE:=FALSE;
  409.   WHILE(NOT DONE) DO
  410.     IF((CMDFIL[FD]=CLOSED) OR (FD=MAXOPEN))THEN
  411.       DONE:=TRUE
  412.     ELSE FD:=SUCC(FD);
  413.   IF(CMDFIL[FD]<>CLOSED) THEN
  414.     FDALLOC:=IOERROR
  415.   ELSE BEGIN
  416.     CMDFIL[FD]:=FTALLOC;
  417.     IF(CMDFIL[FD]=CLOSED) THEN
  418.       FDALLOC:=IOERROR
  419.     ELSE BEGIN
  420.       CMDOPEN[CMDFIL[FD]]:=TRUE;
  421.       FDALLOC:=FD
  422.     END
  423.   END
  424. END;(*FDALLOC*)
  425.  
  426.     PROCEDURE ENDCMD;
  427. VAR FD:FILEDESC;
  428. BEGIN
  429.   FOR FD:=STDIN TO MAXOPEN DO
  430.     XCLOSE(FD)
  431. END;
  432.  
  433. PROCEDURE XCLOSE;
  434. BEGIN
  435.   CASE (CMDFIL[FD])OF
  436.   CLOSED,STDIO:;
  437.   FIL1:CLOSE(FILE1);
  438.   FIL2:CLOSE(FILE2);
  439.   FIL3:CLOSE(FILE3);
  440.   FIL4:CLOSE(FILE4)
  441.   END;
  442.   CMDOPEN[CMDFIL[FD]]:=FALSE;
  443.   CMDFIL[FD]:=CLOSED
  444. END;
  445.  
  446. FUNCTION ADDSTR;
  447. BEGIN
  448.   IF(J>MAXSET)THEN
  449.     ADDSTR:=FALSE
  450.   ELSE BEGIN
  451.     OUTSET[J]:=C;
  452.     J:=J+1;
  453.     ADDSTR:=TRUE
  454.   END
  455. END;
  456.  
  457. PROCEDURE PUTSTR;
  458. VAR I:INTEGER;
  459. BEGIN
  460.   I:=1;
  461.   WHILE(STR[I]<>ENDSTR) DO BEGIN
  462.     PUTCF(STR[I],FD);
  463.     I:=I+1
  464.   END
  465. END;
  466. FUNCTION MUSTOPEN;
  467. VAR FD:FILEDESC;
  468. BEGIN
  469.   FD:=OPEN(NAME,MODE);
  470.   IF(FD=IOERROR)THEN BEGIN
  471.     PUTSTR(NAME,STDERR);
  472.     WRITELN(':  CAN''T OPEN FILE')
  473.   END;
  474.   MUSTOPEN:=FD
  475. END;
  476.  
  477. FUNCTION GETKBD;
  478. VAR DONE:BOOLEAN;
  479.     i:integer;
  480.     ch:char;
  481. BEGIN
  482.   IF (KBDN<=0) THEN BEGIN
  483.     KBDNEXT:=1;
  484.     DONE:=FALSE;
  485.     if (kbdn=-2) then begin kbdn:=0 end
  486.     else if (kbdn<0)then done:=true;
  487.     WHILE(NOT DONE) DO BEGIN
  488.       kbdn:=kbdn+1;
  489.       DONE:=TRUE;
  490.       if (eof(TRM)) then kbdn:=-1
  491.       else if eoln(TRM) then begin
  492.         kbdn:=kbdn-1;kbdline[kbdn]:=NEWLINE
  493.       end
  494.       else if (MAXSTR-1<=kbdn) then begin
  495.         writeln('Line too long');
  496.         kbdline[kbdn]:=newline
  497.       END
  498.       ELSE begin
  499.         read(TRM,ch);kbdline[kbdn]:=ord(ch);
  500.         if (ord(ch)in [0..7,9..12,14..31]) then write('^',chr(ord(ch)+64)) else
  501.         if (kbdline[kbdn]<>BACKSPACE) then
  502.         ELSE begin
  503.           write(ch,' ',ch);
  504.           if (1<kbdn)then begin
  505.             kbdn:=kbdn-2;
  506.             if kbdline[kbdn+1]in[0..31] then write(ch,' ',ch)
  507.           end
  508.           ELSE kbdn:=kbdn-1
  509.         end;
  510.         done:=false
  511.       end;
  512.     END
  513.   END;
  514.   reset(TRM);
  515.   IF(KBDN<=0)THEN
  516.     C:=ENDFILE
  517.   ELSE BEGIN
  518.     C:=KBDLINE[KBDNEXT];
  519.     KBDNEXT:=KBDNEXT+1;
  520.     if (c=NEWLINE) then kbdn:=-2
  521.     ELSE KBDN:=KBDN-1
  522.   END;
  523.   GETKBD:=C
  524. END;
  525.  
  526.  FUNCTION FGETCF;
  527.  VAR CH:CHAR;
  528.  BEGIN
  529.    IF(EOF(FIL))THEN
  530.       FGETCF:=ENDFILE
  531.    ELSE IF(EOLN(FIL)) THEN BEGIN
  532.       READLN(FIL);
  533.       FGETCF:=NEWLINE
  534.    END
  535.    ELSE BEGIN
  536.      READ(FIL,CH);
  537.      FGETCF:=ORD(CH);
  538.    END;
  539.  END;
  540.  
  541.  FUNCTION GETCF;
  542.  BEGIN
  543.    CASE(CMDFIL[FD])OF
  544.    STDIO:C:=GETKBD(C);
  545.    FIL1:C:=FGETCF(FILE1);
  546.    FIL2:C:=FGETCF(FILE2);
  547.    FIL3:C:=FGETCF(FILE3);
  548.    FIL4:C:=FGETCF(FILE4);
  549.    END;
  550.  
  551.    GETCF:=C
  552.  END;
  553.  
  554. FUNCTION GETC;
  555. BEGIN
  556.   GETC:=GETCF(C,STDIN)
  557. END;
  558.  
  559.  PROCEDURE FPUTCF;
  560.  BEGIN
  561.   IF(C=NEWLINE)THEN
  562.     WRITELN(FIL)
  563.   ELSE
  564.     WRITE(FIL,CHR(C))
  565. END;
  566.  
  567. PROCEDURE PUTCF;
  568. BEGIN
  569.   CASE (CMDFIL[FD]) OF
  570.   STDIO:FPUTCF(C,CON);
  571.   FIL1:FPUTCF(C,FILE1);
  572.   FIL2:FPUTCF(C,FILE2);
  573.   FIL3:FPUTCF(C,FILE3);
  574.   FIL4:FPUTCF(C,FILE4)
  575.   END
  576. END;
  577.  
  578.  
  579. PROCEDURE PUTC;
  580. BEGIN
  581.   PUTCF(C,STDOUT);
  582. END;
  583.  
  584. FUNCTION ITOC;
  585. BEGIN
  586.   IF(N<0)THEN BEGIN
  587.     S[I]:=ORD('-');
  588.     ITOC:=ITOC(-N,S,I+1);
  589.   END
  590.   ELSE BEGIN
  591.     IF (N>=10)THEN
  592.       I:=ITOC(N DIV 10,S, I);
  593.     S[I]:=N MOD 10 + ORD('0');
  594.     S[I+1]:=ENDSTR;
  595.     ITOC:=I+1;
  596.   END
  597. END;
  598.  
  599. PROCEDURE PUTDEC;
  600. VAR I,ND:INTEGER;
  601.   S:XSTRING;
  602. BEGIN
  603.   ND:=ITOC(N,S,1);
  604.   FOR I:=ND TO W DO
  605.     PUTC(BLANK);
  606.   FOR I:=1 TO ND-1 DO
  607.     PUTC(S[I])
  608. END;
  609.   
  610. FUNCTION EQUAL;
  611. VAR
  612.   I:INTEGER;
  613. BEGIN
  614.   I:=1;
  615.   WHILE(STR1[I]=STR2[I])AND(STR1[I]<>ENDSTR) DO
  616.     I:=I+1;
  617.   EQUAL:=(STR1[I]=STR2[I])
  618. END;
  619.  
  620.  
  621.